;;;
;;; JaCoLiB
;;; Copyright (C) 2008 Alessandro Serra
;;; 
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

;;;; Created on 2008-07-21 12:09:43

(in-package :jacolib)

;
; RPC Server
;

(defclass rpc-server ()
  ((request-handlers
    :ACCESSOR rpc-server-method-handlers
    :INITFORM (make-hash-table :test 'equal))
   (quit-handler
    :INITARG :quit-handler
    :ACCESSOR rpc-server-quit-handler))
  (:documentation "A RPC Server. 
It defines a set of method handlers (fn:rpc-request->rpc-sesponse)."))

; handlers methods

(defun rpc-server-register-method-handler (rpc-server methodname fn)
  (declare (type rpc-server rpc-server))
  (setf (gethash methodname (rpc-server-method-handlers rpc-server)) fn))

(defun rpc-server-unregister-method-handler (rpc-server methodname)
  (declare (type rpc-server rpc-server))
  (remhash methodname (rpc-server-method-handlers rpc-server)))
  
(defun rpc-server-call-method-handler (rpc-server rpc-request)
  (declare (type rpc-server rpc-server))
  (let ((fn (gethash (rpc-request-method rpc-request) (rpc-server-method-handlers rpc-server))))
    (if (null fn)
        (error 'protocol-error 
               :message (format nil "Invocation of a rpc method (~A) that is not defined." (rpc-request-method rpc-request)))
        (rpc-response-making 
         (funcall fn rpc-request)))))

; quiting

(defun rpc-server-quit (server)
  (funcall (rpc-server-quit-handler server)))

(defgeneric rpc-server-quit% (rpc-server)
  (:method ((rpc-server rpc-server))
    (setf (slot-value rpc-server 'request-handlers) nil)
    (setf (slot-value rpc-server 'quit-handler) nil)
    nil))

; utility

(defmacro make-rpc-method-handler (param-vars &rest code)
  (let ((pos 0))
    `(lambda (rpc-request)
       (let ((method (rpc-request-method rpc-request))
             (params (rpc-request-params rpc-request)))
         (if (/= ,(length param-vars) (length params))
             (error 'protocol-error :message (format nil "Invocation of a rpc method (~A) with the wrong number of parameters [~A instead of ~A]" 
                                                     method (length params) ,(length param-vars))))
         (let* (
                ,@(mapcar #'(lambda (var) 
                              (let ((r (list (first var) `(nth ,pos params))))
                                (setf pos (+ 1 pos))
                                r))
                          param-vars))
           ,@(mapcar #'(lambda (var) 
                         `(if (not (typep ,(first var) ,(second var)))
                              (error 'protocol-error :message (format nil "Invocation of a rpc method (~A) with the wrong type for the parameter ~A [~A instead of ~A]"
                                     method ',(first var) (type-of ,(first var)) ,(second var)))))
                     param-vars)
           ,@code)))))
